Technotools/Technotools (Chestnut CD-ROM)(1993).ISO/lang_pas/ootp_4/listobj.pas

Pascal/Delphi Source File | 1990-03-28 | 8KB | 307 lines

unit ListObj;

{$A+,B-,D+,E+,F-,I+,L+,N-,O-,R-,S+,V+}
{$M 16384,0,655360}

interface

type
    NodePtr = ^Node;
    ListPtr = ^List;
    ListDemonType = function( pNode : pointer ) : boolean;

    List = object
          Head   : NodePtr;
          Tail   : NodePtr;
          Cursor : NodePtr;
          NMem   : integer;
          FindObjectDemon : ListDemonType;
          constructor Init;
          destructor Done;
          procedure Append( pNode : NodePtr );
          procedure Prepend( pNode : NodePtr );
          function PopFirst       : pointer;
          function PopLast        : pointer;
          function PopCursor      : pointer;
          function GetCursor      : pointer;
          function FindObject     : boolean;
          function FindNextObject : boolean;
          end;

    Node = object
           pNext : NodePtr;
           Size  : integer;
           procedure Init( ASize : integer );
           procedure AppendToList( var AList : List ) ;
           procedure PrependToList( var AList : List ) ;
           end;

function FindAll( pNode :pointer ) : boolean;

implementation

constructor List.Init;
begin
     Head := nil;
     Tail := nil;
     Cursor := nil;
     NMem := 0;
     FindObjectDemon := FindAll;
end;

destructor List.Done;
begin
     while (NMem > 0) and (PopFirst <> nil) do {nothing, just do!};
end;

procedure List.Append( pNode : NodePtr );
begin
     if Head = nil then
        begin
        Head := pNode;
        Tail := pNode;
        Inc(NMem);
        end
     else
        begin
        Tail^.pNext := pNode;
        Tail := pNode;
        Inc(NMem);
        end;
     pNode^.pNext := nil;
end;

procedure List.Prepend( pNode : NodePtr );
begin
     if Head = nil then
        begin
        Head := pNode;
        Tail := pNode;
        pNode^.pNext := nil;
        Inc(NMem);
        end
     else
        begin
        pNode^.pNext := Head;
        Head := pNode;
        Inc(NMem);
        end;
end;


function List.PopFirst : pointer;
var
   pFirst : NodePtr;
begin
     if NMem = 1 then begin
        PopFirst := Head;
{        pFirst := Head;
        FreeMem( pFirst, pFirst^.Size );}
        Head := nil;
        Tail := nil;
        Cursor := nil;
        Dec(NMem);
        end
     else
        if NMem > 0 then begin
           PopFirst := Head;
{           pFirst := Head;
           FreeMem( pFirst, pFirst^.Size );}
           if Head <> Tail then begin
              if Cursor = Head then
                 Cursor := Head^.pNext;
              Head := Head^.pNext;
              end;
           Dec(Nmem);
           end
        else begin
            Writeln('ERROR: Attempt to remove element from empty list.');
            PopFirst := nil;
            end;
end;


function List.PopLast : pointer;
var
   pTempNode : NodePtr;
   pLast     : NodePtr;
begin
     if NMem = 1 then begin
        PopLast := Head;
{        pLast := Head;
        FreeMem( pLast, pLast^.Size );}
        Head := nil;
        Tail := nil;
        Cursor := nil;
        Dec(NMem);
        end
     { if there are members in List }
     else
        if NMem > 0 then begin
           { set pNode to be the Head }
           pTempNode := Head;
           { until we find a node that points at the Tail, keep moving }
           while pTempNode^.pNext <> Tail do
                 pTempNode := pTempNode^.pNext;
           { retrieve the object }
           PopLast := Tail;
{           pLast := Tail;
           FreeMem( pLast, pLast^.Size );}
           { the next-to-last node will point at nothing }
           pTempNode^.pNext := nil;
           { if the Cursor pointed at the old Tail }
           if Cursor = Tail then
              Cursor := pTempNode;
           Tail := pTempNode;
           Dec(Nmem);
           end
        else begin
           Writeln('ERROR: Attempt to remove element from empty list.');
           PopLast := nil;
           end;
end;

function List.PopCursor : pointer;
var
   pTempNode : NodePtr;
   pCursor   : NodePtr;
begin
     if NMem = 1 then begin
        PopCursor := Cursor;
{        pCursor := Cursor;
        FreeMem( pCursor, pCursor^.Size );}
        Head := nil;
        Tail := nil;
        Cursor := nil;
        Dec(NMem);
        end
     else if NMem > 0 then begin
             PopCursor := Cursor;
{             pCursor := Cursor;
             FreeMem( pCursor, pCursor^.Size );}
             Dec(Nmem);
             if Cursor <> Head then begin
                pTempNode := Head;
                while pTempNode^.pNext <> Cursor do
                      pTempNode := pTempNode^.pNext;
                { pTempNode points at object in front of Cursor }
                if Cursor <> Tail then begin
                   { if Cursor is not pointing at Tail of List }
                   { make the object in front of the Cursor point }
                   { to the object in back of the cursor }
                   pTempNode^.pNext := Cursor^.pNext;
                   end
                else begin
                   { if the Cursor is pointing at the Tail, }
                   { make the object in front of the Cursor point to nil }
                   { and adjust the Tail }
                   pTempNode^.pNext := nil;
                   Tail := pTempNode;
                   end;
                { set Cursor to point at object in front of itself }
                Cursor := pTempNode;
                end
             else begin { if Cursor = Head }
                Head := Head^.pNext;
                Cursor := Cursor^.pNext;
                end
             end
     else begin
        Writeln('ERROR: Attempt to remove element from empty list.');
        PopCursor := nil;
        end;
end;

{ this function must(!) move the Cursor; since it only returns a pointer }
{ to the Cursor's present position, any test to FindNextObject must start }
{ with the object after the one currently pointed to by the Cursor (else }
{ it will pass the test forever! }
function List.GetCursor : pointer;
begin
     if NMem > 0 then begin
        GetCursor := Cursor;
        { if the Cursor is pointing at the tail, then point it at nil }
        { so that we know we've 'GetCursor'ed the last item in the list }
        if Cursor = Tail then
           Cursor := nil
        else
           Cursor := Cursor^.pNext;
        end
     else
        GetCursor := nil;
end;

function List.FindObject : boolean;
begin
     Cursor := Head;
     FindObject := FindNextObject;
end;

function List.FindNextObject : boolean;
var FoundStatus, AtEnd : boolean;
begin
     { initialize 'FoundStatus' and 'AtEnd' flags }
     FoundStatus := false;
     AtEnd := false;
     { If there are objects in the list and the Cursor is not nil }
     { (indicating that we did a GetCursor operation on the last object }
     {  in the list) }
     if (NMem > 0) and (Cursor <> nil) then begin
        while (AtEnd = false) and (FoundStatus = false) do begin
              if FindObjectDemon( Cursor ) = true then
                 FoundStatus := true
              else
                 if Cursor^.pNext <> nil then
                    Cursor := Cursor^.pNext
                 else
                    AtEnd := true
        end;
     end;
     FindNextObject := FoundStatus;
end;

procedure Node.Init( ASize : integer );
begin
     pNext := nil;
     Size := ASize;
end;

procedure Node.AppendToList( var AList : List ) ;
begin
     if AList.Head = nil then begin
        AList.Head := @Self;
        AList.Tail := @Self;
        Inc(AList.NMem)
        end
     else begin
        AList.Tail^.pNext := @Self;
        AList.Tail := @Self;
        Inc(AList.NMem);
     end;
     pNext := nil;
end;

procedure Node.PrependToList( var AList : List ) ;
begin
     if AList.Head = nil then begin
        AList.Head := @Self;
        AList.Tail := @Self;
        pNext := nil;
        Inc(AList.NMem)
        end
     else begin
        pNext := AList.Head;
        AList.Head := @Self;
        Inc(AList.NMem);
     end;
end;

{$F+}
function FindAll( pNode : pointer ) : boolean;
{$F-}
begin
     FindAll := true;
end;

end.